COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(FILECREATED " 7-May-82 19:50:45" <MASINTER>FELT..3 660    
C00003 00003	(FILECREATED " 7-May-82 19:50:31" <MASINTER>FFTI.LSP.5 3390   
C00009 ENDMK
C⊗;
(FILECREATED " 7-May-82 19:50:45" <MASINTER>FELT..3 660    

     previous date: "30-Mar-82 00:30:40" <MASINTER>FELT..2)


(PRETTYCOMPRINT FELTCOMS)

(RPAQQ FELTCOMS [(MACROS * FELTMACROS)
		 (P (MOVD (QUOTE ELT)
			  (QUOTE FLELT))
		    (MOVD (QUOTE SETA)
			  (QUOTE FLSETA])

(RPAQQ FELTMACROS (FLELT FLSETA))
(DECLARE: EVAL@COMPILE 

(PUTPROPS FLELT MACRO [(A N)
	   (.FLOC. (VAG (OPENR (VAG (IPLUS (LOC A)
					   (ADD1 N])

(PUTPROPS FLSETA MACRO ((A N V)
			(CLOSER (IPLUS (LOC A)
				       (ADD1 N))
				(FLOAT V))))
)
(MOVD (QUOTE ELT)
      (QUOTE FLELT))
(MOVD (QUOTE SETA)
      (QUOTE FLSETA))
(FILECREATED " 7-May-82 19:50:31" <MASINTER>FFTI.LSP.5 3390   

     previous date: " 7-May-82 19:45:09" <MASINTER>FFTI.LSP.4)


(PRETTYCOMPRINT FFTICOMS)

(RPAQQ FFTICOMS ((FNS * FFTIFNS)
		 (LOCALVARS . T)))

(RPAQQ FFTIFNS (FFT TRY))
(DEFINEQ

(FFT
  [LAMBDA (AREAL AIMAG)                         (* edited: 
						"30-Mar-82 00:25")
                                                (* Fast Fourier 
						Transform AREAL = real 
						part, AIMAG = imaginary 
						part)
    (PROG (AR AI PI I J K M N LE LE1 IP NV2 NM1 UR UI WR WI TR TI)
          (SETQ AR AREAL)                       (* Initialize)
          (SETQ AI AIMAG)
          (SETQ PI 3.141593)
          (SETQ N (ARRAYSIZE AR))
          (SETQ NV2 (IQUOTIENT N 2))
          (SETQ NM1 (SUB1 N))
          (SETQ M 0)                            (* Compute M = log 
						(N))
          (SETQ I 1)
      L1  (COND
	    ((ILESSP I N)
	      (SETQ M (ADD1 M))
	      (SETQ I (IPLUS I I))
	      (GO L1)))
          [COND
	    ((NOT (IEQP N (EXPT 2 M)))
	      (PRIN1 "Error ... array size not a power of two.")
	      (HELP)
	      (RETURN (TERPRI]
          (SETQ J 1)                            (* Interchange elements)
          (SETQ I 1)                            (* in bit-reversed 
						order)
      L3  (COND
	    ((ILESSP I J)
	      (SETQ TR (FLELT AR J))
	      (SETQ TI (FLELT AI J))
	      (FLSETA AR J (FLELT AR I))
	      (FLSETA AI J (FLELT AI I))
	      (FLSETA AR I TR)
	      (FLSETA AI I TI)))
          (SETQ K NV2)
      L6  (COND
	    ((ILESSP K J)
	      (SETQ J (IDIFFERENCE J K))
	      (SETQ K (IQUOTIENT K 2))
	      (GO L6)))
          (SETQ J (IPLUS J K))
          (SETQ I (ADD1 I))
          (COND
	    ((ILESSP I N)
	      (GO L3)))
          (for L from 1 to M
	     do                                 (* Loop thru stages)
		(SETQ LE (EXPT 2 L))
		(SETQ LE1 (IQUOTIENT LE 2))
		(SETQ UR 1.0)
		(SETQ UI 0.0)
		[SETQ WR (COS (FQUOTIENT PI (FLOAT LE1]
		[SETQ WI (SIN (FQUOTIENT PI (FLOAT LE1]
		(for J from 1 to LE1
		   do                           (* Loop thru 
						butterflies)
		      (for I←J by (IPLUS I LE) while (ILEQ I N)
			 do                     (* Do a butterfly)
			    (SETQ IP (IPLUS I LE1))
			    (SETQ TR (FDIFFERENCE (FTIMES (FLELT AR IP)
							  UR)
						  (FTIMES (FLELT AI IP)
							  UI)))
			    (SETQ TI (FPLUS (FTIMES (FLELT AR IP)
						    UI)
					    (FTIMES (FLELT AI IP)
						    UR)))
			    (FLSETA AR IP (FDIFFERENCE (FLELT AR I)
						       TR))
			    (FLSETA AI IP (FDIFFERENCE (FLELT AI I)
						       TI))
			    (FLSETA AR I (FPLUS (FLELT AR I)
						TR))
			    (FLSETA AI I (FPLUS (FLELT AI I)
						TI)))
		      (SETQ TR (FDIFFERENCE (FTIMES UR WR)
					    (FTIMES UI WI)))
		      (SETQ TI (FPLUS (FTIMES UR WI)
				      (FTIMES UI WR)))
		      (SETQ UR TR)
		      (SETQ UI TI)))
          (RETURN T])

(TRY
  [LAMBDA (SIZE)                                (* edited: 
						"30-Mar-82 00:26")
    (COND
      ((NULL SIZE)
	(SETQ SIZE 1024)))
    (SETQ RE (ARRAY SIZE (QUOTE FLOATP)))
    (SETQ IM (ARRAY SIZE (QUOTE FLOATP)))
    (for I from 1 to SIZE do (FLSETA RE I (FLOAT 0))
			     (FLSETA IM I (FLOAT 0)))
    (TIME (FFT RE IM)
	  1])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)